home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / sconst.pqs / sconst.pas
Pascal/Delphi Source File  |  1985-11-08  |  16KB  |  470 lines
  1. {$C-}
  2. Program SetConst;
  3.  
  4. {          TURBO DATABASE TOOLBOX DEMONSTRATION PROGRAM
  5.                   SET TURBO-ACCESS CONSTANTS
  6.  
  7.     This program can be used to help you determine appropriate
  8.     values for the constants required in ACCESS.BOX.
  9.  
  10.     Please note that some useful  keyboard input  routines are
  11.     included below.
  12. }
  13.  
  14. Const
  15.   Version='1.10A';
  16.  
  17. Var
  18.   MaxDataRecSize,MaxKeyLen,StackMem,MaxRecs,PageSize,PageStackSize,
  19.   MaxHeight,MaxMaxHeight,Order,MaxSearch,MemSearch,DiskSearch,IrSize,Density,
  20.   IxSize,DxSize,PerPage,TotalPages: Real;
  21.   DFactor: Integer;
  22.   Done: Boolean;
  23.  
  24. Type
  25.   Buffer=String[255];
  26.  
  27. Procedure Abort(Msg: Buffer);
  28.   Begin
  29.     GoToXY(1,24);
  30.     WriteLn;
  31.     WriteLn(Msg);
  32.     Halt;
  33.   End; { Abort }
  34.  
  35. Procedure CW;                { Clear to end of line before advancing to next }
  36.   Begin
  37.     ClrEol;
  38.     WriteLn;
  39.   End; { CW }
  40.  
  41. Procedure SetScreenUp;                         { Set up the worksheet screen }
  42.   Begin
  43.     ClrScr;
  44.     LowVideo;
  45.     WriteLn('==       Turbo Access constant determination worksheet, Version ',
  46.             Version,'        ==');
  47.     WriteLn;
  48.     WriteLn('Data record size (bytes)');
  49.     WriteLn('Key string length (characters)');
  50.     WriteLn('Size of the database (records)');
  51.     WriteLn('Page size (keys)');
  52.     WriteLn('Page stack size (pages)');
  53.     WriteLn;
  54.     WriteLn('Density (Percent of Items in use per average Page)',' ':2,'50%','75%':12,'100%':12);
  55.     WriteLn;
  56.     WriteLn('Total index file pages');
  57.     WriteLn('Memory used for page stack (bytes)');
  58.     WriteLn('Index file page size (bytes)');
  59.     WriteLn('Index file size (bytes)');
  60.     WriteLn('Data file size (bytes)');
  61.     WriteLn;
  62.     WriteLn('Order');
  63.     WriteLn('MaxHeight');
  64.     WriteLn('Average searches needed to find a key');
  65.     WriteLn('Average searches satisfied by page stack');
  66.     WriteLn('Average disk searches needed to find a key');
  67.     WriteLn;
  68.     NormVideo;
  69.     WriteLn('ESC to end program');
  70.     LowVideo;
  71.   End; { SetScreenUp }
  72.  
  73. Procedure ShowParms;       { Show current input values to left of input area }
  74.   Begin
  75.     GotoXY(45,3); Write(MaxDataRecSize:11:0); ClrEol;
  76.     GotoXY(45,4); Write(MaxKeyLen:11:0); ClrEol;
  77.     GotoXY(45,5); Write(MaxRecs:11:0); ClrEol;
  78.     GotoXY(45,6); Write(PageSize:11:0); ClrEol;
  79.     GotoXY(45,7); Write(PageStackSize:11:0); ClrEol;
  80.   End; { ShowParms }
  81.  
  82. { ======================== LINE EDIT MODULE ================================ }
  83. {
  84.   This is a set of three routines that can be used in a Turbo Pascal program
  85.   for getting input from the keyboard. Each routine provides WordStar-like
  86.   editing of the input, an undo function, and pre-setting of the input buffer.
  87.   A buffer is passed in, which in most cases will contain the old value of the
  88.   variable being read.  If the global variable ShowBuffer is set to True, the
  89.   incoming buffer will be displayed, ready to be edited.  If it is False, the
  90.   incoming buffer will not be displayed but can be recalled with many of the
  91.   editing keys.  ShowBuffer MUST BE INITIALIZED for results to be predictable!!!
  92.  
  93.   Here is a list of the control characters used (including synonymous IBM PC
  94.   function keys):
  95.  
  96.   ^A  Move to beginning of line, nondestructive              [Ctrl-LeftArrow]
  97.   ^B  Save current buffer in undo buffer
  98.   ^D  Move forward one                                       [RightArrow]
  99.   ^F  Move to end of line (same as ^R)                       [Ctrl-RightArrow]
  100.   ^G  Delete character forward                               [DEL]
  101.   ^H  Move back 1, destructive (same as ASCII DEL)           [BackSpace]
  102.   ^J  End of input; accept entire buffer                     [Ctrl-Enter]
  103.   ^M  End of input; accept what is currently visible         [Enter]
  104.   ^N  End of input; accept entire buffer
  105.   ^P  Accept next character as-is (control character prefix)
  106.   ^R  Move to end of line (same as ^F)
  107.   ^S  Move back 1, nondestructive                            [LeftArrow]
  108.   ^T  Delete line forward                                    [Ctrl-End]
  109.   ^U  Copy undo buffer into current buffer (undo)
  110.   ^V  Insert on/off                                          [INS]
  111.   ^X  Move to beginning of line, destructive                 [Ctrl-Home]
  112.   ^Y  Delete line
  113.   DEL Move back 1, destructive (same as ^H) (ASCII DEL, not IBM PC DEL)
  114.   ESC End of input; accept what is currently visible
  115.  
  116.   The initial contents of both the current buffer and the undo buffer are set
  117.   by the parameter Param.
  118.  
  119.   The character used to end input (^J, ^M, ^N, or ESC) is returned in the
  120.   global variable AskTerminator.
  121.  
  122.   These routines will work with any version of Turbo Pascal.
  123. }
  124.  
  125. Type
  126.   CharSet=Set Of Char;
  127.  
  128. Const
  129.   TermChars: CharSet=[^C,^J,^M,^N,^[];
  130.  
  131. Var
  132.   ShowBuffer: Boolean; { Input: should the buffer be displayed at the start? }
  133.   AskTerminator: Char; { Output: Returns the terminator -- ^J, ^M, ^N or ESC }
  134.  
  135. Function AskString(Prompt,Param: Buffer; LegalChars: CharSet;
  136.                    MaxLen: Byte): Buffer;
  137.   Const
  138.     ESC=^[;
  139.     DEL=#$7F;
  140.     InsertFlag: Boolean=True;
  141.  
  142.   Var
  143.     AS: Buffer;
  144.     Cursor: Integer;
  145.     Ch: Char;
  146.     WasChar,WasFunKey,First: Boolean;
  147.  
  148.   Procedure PutC;
  149.     Var
  150.       C: Char;
  151.     Begin
  152.       C:=AS[Cursor];
  153.       If C<' ' Then Write('^',Chr(Ord(C)+64))
  154.       Else Write(C);
  155.     End; { PutC }
  156.  
  157.   Procedure UnPutC;
  158.     Var
  159.       C: Char;
  160.     Begin
  161.       C:=AS[Cursor];
  162.       Write(^H' '^H);
  163.       If C<' ' Then Write(^H' '^H);
  164.     End; { UnPutC }
  165.  
  166.   Begin { AskString }
  167.     Write(Prompt);
  168.     AS:=Param;
  169.     Cursor:=0;
  170.     First:=True;
  171.     Repeat
  172.       If First And ShowBuffer Then
  173.        Begin
  174.         First:=False;
  175.         Ch:=^R;
  176.        End
  177.       Else Read(Kbd,Ch);
  178.       WasChar:=False;
  179.       WasFunKey:=(Ch=ESC) And KeyPressed;
  180.       If WasFunKey Then
  181.        Begin
  182.         Read(Kbd,Ch);
  183.         Case Ch Of
  184.           's','G': Ch:=^A; { Ctrl-LeftArrow, Home }
  185.           'M': Ch:=^D;     { RightArrow }
  186.           'S': Ch:=^G;     { DEL }
  187.           'K': Ch:=^S;     { LeftArrow }
  188.           'u': Ch:=^T;     { Ctrl-End }
  189.           'R': Ch:=^V;     { INS }
  190.           'w': Ch:=^X;     { Ctrl-Home }
  191.           Else Ch:=^F;     { Ctrl-RightArrow, End, all unknowns }
  192.          End;
  193.        End;
  194.       Case Ch Of
  195.         ^A,^U,^X,^Y: Begin
  196.                        While Cursor>0 Do
  197.                         Begin
  198.                          UnPutC;
  199.                          If Ch=^X Then Delete(AS,Cursor,1);
  200.                          Cursor:=Cursor-1;
  201.                         End;
  202.                        If Ch=^U Then AS:=Param
  203.                        Else If Ch=^Y Then AS:='';
  204.                      End;
  205.         ^B: Param:=AS;
  206.         ^D: If Length(AS)>Cursor Then
  207.              Begin
  208.               Cursor:=Cursor+1;
  209.               PutC;
  210.              End;
  211.         ^F,^R,^N,^J: While Length(AS)>Cursor Do
  212.                       Begin
  213.                        Cursor:=Cursor+1;
  214.                        PutC;
  215.                       End;
  216.         ^G: Delete(AS,Cursor+1,1);
  217.         ^H,^S,DEL: If Cursor>0 Then
  218.                     Begin
  219.                      UnPutC;
  220.                      If Ch<>^S Then Delete(AS,Cursor,1);
  221.                      Cursor:=Cursor-1;
  222.                     End;
  223.         ^P: Begin
  224.               Read(Kbd,Ch);
  225.               WasChar:=True;
  226.             End;
  227.         ^T: Delete(AS,Cursor+1,Length(AS));
  228.         ^V: InsertFlag:=Not InsertFlag;
  229.         Else WasChar:=Not (Ch In TermChars);           { Case Else }
  230.        End;
  231.       If WasChar And (Length(AS)<MaxLen) And (Ch In LegalChars) Then
  232.        Begin
  233.         Cursor:=Cursor+1;
  234.         If InsertFlag Then Insert(Ch,AS,Cursor)
  235.         Else AS[Cursor]:=Ch;
  236.         If Cursor>Length(AS) Then AS[0]:=Chr(Cursor);
  237.         PutC;
  238.        End
  239.       Else If WasChar Then ;      { Add:  Write(^G) to ring the bell }
  240.      Until (Ch In TermChars) And Not WasChar;
  241.     AskTerminator:=Ch;
  242.     AskString:=Copy(AS,1,Cursor);
  243.   End; { AskString }
  244.  
  245. Function AskInt(Prompt: Buffer; Param: Integer; MaxLen: Byte): Integer;
  246.   Var
  247.     Temp: Buffer;
  248.     P,I: Integer;
  249.   Begin
  250.     Str(Param,Temp);
  251.     Temp:=AskString(Prompt,Temp, ['0'..'9', '-'], MaxLen);
  252.     Val(Temp,P,I);
  253.     If Length(Temp)=0 Then AskInt:=0
  254.     Else If I=0 Then AskInt:=P
  255.     Else AskInt:=Param;
  256.   End; { AskInt }
  257.  
  258. Function AskReal(Prompt: Buffer; Param: Real; MaxLen: Byte): Real;
  259.   Var
  260.     Temp: Buffer;
  261.     P: Real;
  262.     I: Integer;
  263.   Begin
  264.     Str(Param:1:12,Temp);
  265.     I:=14;
  266.     While Temp[I]='0' Do I:=I-1;
  267.     If Temp[I]='.' Then I:=I-1;
  268.     Temp:=AskString(Prompt,Copy(Temp,1,I),['0'..'9', '.', '-'], MaxLen);
  269.     Val(Temp,P,I);
  270.     If Length(Temp)=0 Then AskReal:=0.0
  271.     Else If I=0 Then AskReal:=P
  272.     Else AskReal:=Param;
  273.   End; { AskReal }
  274.  
  275. { ======================== END OF LINE EDIT MODULE ========================= }
  276.  
  277. Procedure GetParms;              { Get new values for the 5 input parameters }
  278.  
  279.   Procedure ErrorMsg(B: Buffer);         { Print an error message on line 24 }
  280.     Var Ch: Char;
  281.     Begin
  282.       GotoXY(1,24);
  283.       Write('Error: ',B,'!  Hit any key: ');
  284.       Read(Kbd,Ch);
  285.       GotoXY(1,24);
  286.       Write(' ':22+Length(B));
  287.       AskTerminator := ^M;{ Prevent ESC from ending program on illegal value }
  288.     End; { ErrorMsg }
  289.  
  290.   Var I: Integer;
  291.  
  292.   Begin { GetParms }
  293.     ShowBuffer:=True;{ Tell AskString to start out with its buffer displayed }
  294.     I:=1;
  295.     NormVideo;                                        { Hilight input values }
  296.     Repeat
  297.       GotoXY(62,I+2);
  298.       Case I Of
  299.                     { For each I, input a value for its associated variable. }
  300.                     { Then check that value for validity.  If it is valid,   }
  301.                     { increment I so that the next variable is read;         }
  302.                     { otherwise, complain and try again.                     }
  303.         1: Begin
  304.              MaxDataRecSize:=Int(AskReal('',MaxDataRecSize, 6));
  305.              If (MaxDataRecSize>=8.0) And (MaxDataRecSize<65536.0) Then I:=2
  306.              Else ErrorMsg('MaxDataRecSize must be between 8 and 65535');
  307.            End;
  308.         2: Begin
  309.              MaxKeyLen:=Int(AskReal('',MaxKeyLen, 6));
  310.              If (MaxKeyLen>=1.0) And (MaxKeyLen<=255.0) Then I:=3
  311.              Else ErrorMsg('MaxKeyLen must be between 1 and 255');
  312.            End;
  313.         3: Begin
  314.              MaxRecs:=Int(AskReal('',MaxRecs, 6));
  315.              If MaxRecs>0.0 Then I:=4
  316.              Else ErrorMsg('Most databases have a positive number of records');
  317.            End;
  318.         4: Begin
  319.              PageSize:=Int(AskReal('',PageSize, 6));
  320.              If (PageSize>=4.0) And (PageSize<=254.0)
  321.                 And Not Odd(Trunc(PageSize)) Then I:=5
  322.              Else ErrorMsg('PageSize must be an even integer between 4 and 254');
  323.            End;
  324.         5: Begin
  325.              PageStackSize:=Int(AskReal('',PageStackSize, 6));
  326.              If (PageStackSize>=3.0) And (PageStackSize<=254.0) Then I:=6
  327.              Else ErrorMsg('PageStackSize must be between 3 and 254');
  328.            End;
  329.        End;
  330.       If AskTerminator=^C Then Abort('INTERRUPTED');
  331.       Done:=(AskTerminator=^[);
  332.     Until (I=6) Or Done;
  333.     LowVideo;
  334.   End; { GetParms }
  335.  
  336. Procedure Calculate;        { Calculate the derived constants from the input }
  337.                             { constants, for a given density                 }
  338.   Var
  339.     M,Temp: Real;
  340.     I: Integer;
  341.   Begin
  342.     Density:=DFactor/4;
  343.     Order:=PageSize/2;
  344.     PerPage:=PageSize*Density;
  345.     MaxSearch:=Ln(MaxRecs)/Ln(PerPage);
  346.     MaxHeight:=Trunc(MaxSearch+1.0);
  347.     TotalPages:=Int(MaxRecs/PerPage+1.0);
  348.     Temp:=1.0;
  349.     M:=PerPage;
  350.     I:=1;
  351.     While Temp+M<PageStackSize Do
  352.      Begin
  353.       Temp:=Temp+M;
  354.       I:=I+1;
  355.       M:=Exp(Ln(PerPage)*I);
  356.      End;
  357.     If Temp+M>TotalPages Then M:=TotalPages-Temp+1;
  358.     MemSearch:=I+(PageStackSize-Temp)/M;
  359.     DiskSearch:=MaxSearch-MemSearch;
  360.     IrSize:=(MaxKeyLen+5)*PageSize+3;
  361.     IxSize:=IrSize*TotalPages;
  362.     DxSize:=MaxDataRecSize*(MaxRecs+1);
  363.     StackMem:=IrSize*PageStackSize;
  364.   End; { Calculate }
  365.  
  366. Procedure ShowResults;      { Show the derived constants for a given density }
  367.   Begin
  368.     GotoXY(21+DFactor*12,11); Write(TotalPages:11:0);
  369.     GotoXY(21+DFactor*12,12); Write(StackMem:11:0);
  370.     GotoXY(21+DFactor*12,13); Write(IrSize:11:0);
  371.     GotoXY(21+DFactor*12,14); Write(IxSize:11:0);
  372.     GotoXY(21+DFactor*12,15); Write(DxSize:11:0);
  373.     GotoXY(21+DFactor*12,17); Write(Order:11:0);
  374.     GotoXY(21+DFactor*12,18); Write(MaxHeight:11:0);
  375.     GotoXY(21+DFactor*12,19); Write(MaxSearch:11:2);
  376.     GotoXY(21+DFactor*12,20); Write(MemSearch:11:2);
  377.     GotoXY(21+DFactor*12,21); Write(DiskSearch:11:2);
  378.   End; { ShowResults }
  379.  
  380. Procedure GiveConstSection;{ Output the Database Toolbox constants to a file }
  381.   Var Ch: Char;
  382.       FileName: String[66];
  383.       T: Text;
  384.   Begin
  385.     GotoXY(1,24);
  386.     WriteLn;
  387.     Write('Do you want to save these constants to a file (Y/N)? ');
  388.     Repeat
  389.       Read(Kbd,Ch);
  390.       Ch:=UpCase(Ch);
  391.     Until Ch In ['Y','N',^C,^[];
  392.     If Ch<>'Y' Then
  393.      Begin
  394.       WriteLn('No');
  395.       Halt;
  396.      End
  397.     Else WriteLn('Yes');
  398.     FileName:='';
  399.     Repeat
  400.       Ch:='Y';
  401.       FileName:=AskString('Filename: ',FileName,[#32..#126],66);
  402.       WriteLn;
  403.       If (FileName='') Or (AskTerminator=^[) Then Halt;
  404.       Assign(T,FileName);
  405.       {$I-} Reset(T); {$I+}
  406.       If IOResult=0 Then
  407.        Begin
  408.         Close(T);
  409.         Write(FileName,' already exists.  Overwrite it (Y/N)? ');
  410.         Repeat
  411.           Read(Kbd,Ch);
  412.           Ch:=UpCase(Ch);
  413.         Until Ch In ['Y','N',^C,^[];
  414.         If Ch<>'Y' Then
  415.          Begin
  416.           WriteLn('No');
  417.           If Ch<>'N' Then Halt;
  418.          End
  419.         Else WriteLn('Yes');
  420.        End;
  421.       If Ch='Y' Then
  422.        Begin
  423.         Assign(T,FileName);
  424.         {$I-} Rewrite(T); {$I+}
  425.         If IOResult<>0 Then
  426.          Begin
  427.           WriteLn(FileName,' could not be created.');
  428.           Ch:='N';
  429.          End;
  430.        End;
  431.     Until Ch='Y';
  432.     WriteLn(T,'Const');
  433.     WriteLn(T,'  MaxDataRecSize = ',MaxDataRecSize:3:0, ';');
  434.     WriteLn(T,'  MaxKeyLen      = ',MaxKeyLen:3:0, ';');
  435.     WriteLn(T,'  PageSize       = ',PageSize:3:0, ';');
  436.     WriteLn(T,'  Order          = ',Order:3:0, ';');
  437.     WriteLn(T,'  PageStackSize  = ',PageStackSize:3:0, ';');
  438.     WriteLn(T,'  MaxHeight      = ',MaxMaxHeight:3:0, ';');
  439.     Close(T);
  440.   End; { GiveConstSection }
  441.  
  442. Procedure Init;                                { Initialize global variables }
  443.   Begin
  444.     MaxDataRecSize:=200;             { Set up some reasonable default values }
  445.     MaxKeyLen:=10;
  446.     MaxRecs:=10000;
  447.     PageSize:=24;
  448.     PageStackSize:=10;
  449.     Done:=False;
  450.   End; { Init }
  451.  
  452. Begin { SetConst }
  453.   SetScreenUp;
  454.   Init;
  455.   ShowParms;
  456.   Repeat
  457.     GetParms;                                { Get a set of input parameters }
  458.     ShowParms;                                                   { Show them }
  459.     MaxMaxHeight:=0;
  460.     For DFactor:=2 To 4 Do                               { For each density, }
  461.      Begin
  462.       Calculate;                          { calculate the derived constants, }
  463.       If MaxHeight>MaxMaxHeight Then
  464.         MaxMaxHeight:=MaxHeight;         { (be conservative with MaxHeight), }
  465.       ShowResults;                                   { then show the results }
  466.      End;
  467.   Until Done;                                  { Stop when the user hits ESC }
  468.   GiveConstSection;                  { Save the Toolbox constants to a file? }
  469. End. { SetConst }